Shareware Grab Bag/Shareware Grab Bag.iso/001/pibt3sp2.arc/PIBHOSTC.PAS

Pascal/Delphi Source File | 1985-10-03 | 27.1 KB | 736 lines

(*----------------------------------------------------------------------*)
(*            Second host mode overlay section starts here              *)
(*----------------------------------------------------------------------*)

CONST
   Start_Host_Overlay_Two = 1;

(*----------------------------------------------------------------------*)
(*            Do_Host --- Controls execution of host mode               *)
(*----------------------------------------------------------------------*)

OVERLAY PROCEDURE Do_Host;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Do_Host                                              *)
(*                                                                      *)
(*     Purpose:    Controls host mode                                   *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Do_Host;                                                      *)
(*                                                                      *)
(*      Calls:   Async_Send                                             *)
(*               Async_Receive                                          *)
(*               KeyPressed                                             *)
(*               Process_Command                                        *)
(*               ClrScr                                                 *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Done   : BOOLEAN                (* TRUE to exit host mode            *);
   Found  : BOOLEAN                (* TRUE if user name found           *);
   Ch     : CHAR                   (* Character read/written            *);
   S_Ch   : CHAR                   (* Parity_stripped character         *);
   MyPass : AnyStr                 (* Password                          *);
   Try    : INTEGER                (* Number of login attempts          *);
   Back   : BOOLEAN                (* Back from file transfers          *);

BEGIN (* Do_Host *)
                                   (* Clear comm line of garbage *)
   Async_Purge_Buffer;
                                   (* Expert mode OFF by default *)
   Expert_On  := FALSE;
                                   (* Assume line feeds not needed *)
   CR_LF_Host := CHR( CR );
                                   (* Welcome and linefeed check *)
   Done       := FALSE;

   Host_Send_String_With_CR('PibTerm V3.0, October, 1985');
   Host_Send_String_With_CR('Beginning Remote Communications');
   Host_Send_String_With_CR(' ');
   Host_Send_String_With_CR('Test if line feeds required ...');

   REPEAT

      Async_Purge_Buffer;

      Host_Send_String_With_CR(' ');
      Host_Send_String_And_Echo('Are these lines O V E R P R I N T I N G ?');

      REPEAT
      UNTIL Async_Receive( Ch ) OR KeyPressed OR ( NOT Host_Carrier_Detect );

      S_Ch := CHR( ORD( Ch ) AND $7F );

                                   (* Alter parity if required *)
      IF ( S_Ch <> Ch ) THEN
         BEGIN

            IF Parity = 'N' THEN
               BEGIN
                  Parity    := 'E';
                  Data_Bits := 7;
               END
            ELSE
               BEGIN
                  Parity    := 'N';
                  Data_Bits := 8;
               END;

            Async_Reset_Port( Comm_Port, Baud_Rate, Parity,
                              Data_Bits, Stop_Bits );

            WRITELN;
            WRITELN('Communication re-adjusted to parity = ',Parity,
                    ' and data bits = ',Data_Bits);
            WRITELN;

         END;
                                   (* Look for keyboard input if any *)
      IF KeyPressed THEN
         BEGIN
            READ( KBD, S_Ch );
            IF ( S_Ch = CHR( ESC ) ) THEN
               Done := TRUE;
         END;

      IF ( NOT Done ) THEN
         BEGIN

            S_Ch := UpCase( S_Ch );

            Host_Send( S_Ch );

            IF Printer_On THEN
               WRITE( Lst , S_Ch );

            IF Capture_On THEN
               WRITE( Capture_File , S_Ch );

         END;

      Done := Done OR ( NOT Host_Carrier_Detect );

   UNTIL ( S_Ch IN ['Y','N'] ) OR Done;

   IF Done THEN Exit;

   IF S_Ch = 'Y' THEN
      CR_LF_Host := CHR( CR ) + CHR( LF )
   ELSE
      CR_LF_Host := CHR( CR );
                                   (* Get user's ID and password *)
   Try := 0;

   REPEAT
       Try := Try + 1;
       Get_UserInfo( Found );
   UNTIL( ( Try > Max_Login_Try ) OR Found );

                                   (* Check for bad logon or carrier drop *)

   Done := Done OR ( NOT Found ) OR ( NOT Host_Carrier_Detect );

                                   (* Continue to main menu if OK *)
   IF ( NOT Done ) THEN
      BEGIN
                                   (* Mark this as first entry here  *)
         Host_Section := 'I';
                                   (* Loop over main menu until done *)
         REPEAT

            IF Host_Section <> 'F' THEN
               Process_Host_Commands( Done )
            ELSE
               REPEAT
                  Process_File_Transfer_Commands( Done, Back );
               UNTIL( Done OR Back );

            Done := Done OR ( NOT Host_Carrier_Detect );

         UNTIL ( Done );

      END;
                                   (* Open log file and record this logout *)

   ASSIGN( Log_File, 'PIBTERM.LOG' );
      (*$I-*)
   RESET ( Log_File );
      (*$I+*)

   IF Int24Result = 0 THEN
      BEGIN
         CLOSE( Log_File );
         APPEND( Log_File );
      END
   ELSE
      REWRITE( Log_File );

   WRITELN( Log_File,'----- Logged off at ',TimeString( TimeOfDay ),' on ',
            DateString );

      (*$I-*)
   CLOSE( Log_File );
      (*$I+*)

END   (* Do_Host *);

(*----------------------------------------------------------------------*)
(*          Initialize_Host_Mode --- Initializes host mode              *)
(*----------------------------------------------------------------------*)

OVERLAY PROCEDURE Initialize_Host_Mode;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Initialize_Host_Mode                                 *)
(*                                                                      *)
(*     Purpose:    Initializes host mode.                               *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Initialize_Host_Mode;                                         *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*       This routine reads the user file into memory and scans the     *)
(*       message file as well.  The asynchronous communications port    *)
(*       is also initialized.                                           *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Qerr     : BOOLEAN;
   User_Line: AnyStr;
   I        : INTEGER;
   Done_Flag: BOOLEAN;

(*----------------------------------------------------------------------*)
(*            Get_A_String --- get string up to specified delimeter     *)
(*----------------------------------------------------------------------*)

FUNCTION Get_A_String( S : AnyStr; VAR IS: INTEGER; Delim: CHAR ) : AnyStr;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:   Get_A_String                                         *)
(*                                                                      *)
(*     Purpose:    Gets string up to specified delimeter.               *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        D_String := Get_A_String( S : AnyStr; VAR IS: INTEGER;        *)
(*                                  Delim: CHAR ) : AnyStr;             *)
(*                                                                      *)
(*           S        --- string to be scanned                          *)
(*           IS       --- first position in S to be scanned             *)
(*           Delim    --- delimeter character to mark end of string     *)
(*                                                                      *)
(*           D_String --- returns substring of S beginning at IS and    *)
(*                        proceeding up to (but not including) Delim,   *)
(*                        or end of string.                             *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   T: AnyStr;

BEGIN (* Get_A_String *)

   T := '';

   WHILE ( IS <= LENGTH( S ) ) AND ( S[IS] <> Delim ) DO
      BEGIN
         T  := T + S[IS];
         IS := IS + 1;
      END;

   Get_A_String := T;

END   (* Get_A_String *);

(*----------------------------------------------------------------------*)

BEGIN (* Initialize_Host_Mode *)

   ClrScr;
                                   (* Initialize communications *)
   Async_Init;

   Qerr := Async_Open( Comm_Port, Baud_Rate,
                       Parity, Data_Bits, Stop_Bits );

                                   (* Set the modem *)

   Send_Modem_Command( Modem_Host_Set );

   DELAY( One_Second_Delay );

   Async_Purge_Buffer;
                                   (* Read in the user file *)

   ASSIGN( User_File, Home_Dir + 'PIBTERM.USF' );
      (*$I-*)
   RESET ( User_File );
      (*$I+*)

   IF Int24Result <> 0 THEN
      BEGIN
         WRITELN(' ');
         WRITELN('Can''t open user file, host session ended.');
         WRITELN(' ');
         Really_Done := TRUE;
      END
   ELSE
      BEGIN

         NUsers := 0;

         REPEAT

            NUsers := NUsers + 1;

            READLN( User_File , User_Line );

            WITH User_List[NUsers] DO
               BEGIN
                  I          := 1;
                  First_Name := Trim( UpperCase( Get_A_String( User_Line, I, ';') ) );
                  I          := I + 1;
                  Last_Name  := Trim( UpperCase( Get_A_String( User_Line, I, ';') ) );
                  I          := I + 1;
                  PassWord   := Trim( Get_A_String( User_Line, I, ';') );
               END;

         UNTIL ( EOF( User_File ) OR ( NUsers >= MaxUsers ) );

           (*$I-*)
         CLOSE( User_File );
           (*$I+*)

         WRITELN('There are ',NUsers,' users recorded in user file.');

      END;
                                   (* Scan message file to see how *)
                                   (* many messages there are      *)
   NMessages := 0;

   ASSIGN( Message_File , Home_Dir + 'PIBTERM.MSG' );
      (*$I-*)
   RESET( Message_File );
      (*$I+*)

   IF Int24Result <> 0 THEN
      BEGIN
         WRITELN('No messages in message base.');
      END
   ELSE
      REPEAT

         READLN( Message_File , Message_Line );

         IF COPY( Message_Line, 1, 6 ) = '== End' THEN
            NMessages := NMessages + 1;

      UNTIL ( EOF( Message_File ) );

   IF NMessages > 0 THEN
      WRITELN('There are ', NMessages,' messages in message base.');

      (*$I-*)
   CLOSE( Message_File );
      (*$I+*)

END   (* Initialize_Host_Mode *);

(*----------------------------------------------------------------------*)
(*             Terminate_Host_Mode --- Terminate host mode              *)
(*----------------------------------------------------------------------*)

OVERLAY PROCEDURE Terminate_Host_Mode;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Terminate_Host_Mode                                  *)
(*                                                                      *)
(*     Purpose:    Terminates host mode.                                *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Terminate_Host_Mode;                                          *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*       This routine hangs up the phone.                               *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

BEGIN (* Terminate_Host_Mode *)
                                   (* Hang up the phone *)
   IF ( NOT Local_Host ) THEN
      HangUpPhone;

   WRITELN;
   WRITELN('Host session ended.');

END   (* Terminate_Host_Mode *);

(*----------------------------------------------------------------------*)
(*        Wait_For_Ring --- Wait for phone to ring and answer it        *)
(*----------------------------------------------------------------------*)

OVERLAY PROCEDURE Wait_For_Ring( VAR Done: BOOLEAN );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Wait_For_Ring                                        *)
(*                                                                      *)
(*     Purpose:    Answers the phone in host mode.                      *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Wait_For_Ring( VAR Done : BOOLEAN );                          *)
(*                                                                      *)
(*           Done -- set TRUE if carrier drops or Sysop requests        *)
(*                   host mode termination.                             *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*       This routine answers the phone and analyzes the modem response *)
(*       in order to set the proper baud rate for communications.       *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Qerr:      BOOLEAN;
   Modem_Ans: AnyStr;
   Ch:        CHAR;
   I:         INTEGER;
   J:         INTEGER;
   MTimeOut:  BOOLEAN;
   Int_Ch:    INTEGER;

(*----------------------------------------------------------------------*)
(*         Host_Baud_Detect --- Detect caller's baud rate from CRs      *)
(*----------------------------------------------------------------------*)

PROCEDURE Host_Baud_Detect;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Host_Baud_Detect                                     *)
(*                                                                      *)
(*     Purpose:    Detects caller's baud rate from CR entries           *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Host_Baud_Detect;                                             *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        Async_Receive_With_TimeOut                                    *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*        The initial baud rate is set to 300 baud.  Then, as the       *)
(*        enters characters, we look at each and alter the baud rate    *)
(*        until something recognizable emerges.                         *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

CONST
   Wait_Ch_Time = 1                (* Seconds to wait for a character *);

                                   (* Supported host mode baud rates *)
   N_Of_Host_Baud_Rates = 3;

   Host_Baud_Rates : ARRAY[1..N_Of_Host_Baud_Rates] OF INTEGER
                     = ( 2400, 1200, 300 );

VAR
   Found_Speed : BOOLEAN;
   IBaud       : INTEGER;

(*----------------------------------------------------------------------*)
(*               Try_Baud_Rate --- Try a specified baud rate            *)
(*----------------------------------------------------------------------*)

FUNCTION Try_Baud_Rate( Test_Baud_Rate: INTEGER ) : BOOLEAN;

VAR
   Stripped_Ch : INTEGER;
   Timed_Out   : BOOLEAN;
   Ch          : INTEGER;

BEGIN (* Try_Baud_Rate *)
                                   (* Assume this baud rate fails *)
   Try_Baud_Rate := FALSE;
                                   (* Set port to given baud rate *)
   Baud_Rate     := Test_Baud_Rate;

   Async_Reset_Port( Comm_Port, Baud_Rate, Parity, Data_Bits, Stop_Bits );

                                   (* Wait for a character              *)

   Async_Receive_With_TimeOut( Wait_Ch_Time , Ch );
   Timed_Out := ( Ch = TimeOut );
   Async_Clear_Errors;
                                   (* Strip parity bit                 *)
   Stripped_Ch := ( Ch AND $7F );
                                   (* See if it's recognizable as CR   *)
                                   (* or space.  If so, then check     *)
                                   (* the parity.                      *)
   IF ( NOT Timed_Out ) THEN
      IF ( Stripped_Ch = CR     )   OR
         ( Stripped_Ch = ORD(' ') ) THEN
         BEGIN
            Try_Baud_Rate := TRUE;
            IF ( Stripped_Ch <> Ch ) THEN
               BEGIN
                  IF Parity = 'N' THEN
                     BEGIN
                        Parity    := 'E';
                        Data_Bits := 7;
                     END
                  ELSE
                     BEGIN
                        Parity    := 'N';
                        Data_Bits := 8;
                     END;
                  Async_Reset_Port( Comm_Port, Baud_Rate, Parity,
                                    Data_Bits, Stop_Bits );
               END;
         END;

END   (* Try_Baud_Rate *);

(*----------------------------------------------------------------------*)

BEGIN (* Host_Baud_Detect *)
                                   (* Indicates if speed detected       *)
   Found_Speed := FALSE;
                                   (* Wait for modem messages to appear *)

   DELAY( 2 * Tenth_Of_A_Second_Delay );

                                   (* Purge the receive buffer          *)
   Async_Purge_Buffer;
                                   (* Loop until speed found            *)

   WHILE ( NOT Found_Speed ) AND ( Async_Carrier_Detect ) DO
      BEGIN

         IBaud := 0;
                                   (* Try each baud rate in turn        *)
         REPEAT

            IBaud       := IBaud + 1;
            Parity      := 'N';
            Data_Bits   := 8;
            Found_Speed := Try_Baud_Rate( Host_Baud_Rates[IBaud] );

         UNTIL ( Found_Speed ) OR ( IBaud >= N_Of_Host_Baud_Rates );

                                   (* If we found the speed, try   *)
                                   (* getting a second character.  *)
                                   (* If it's not recognizable,    *)
                                   (* then it didn't work.         *)
         IF Found_Speed THEN
            Found_Speed := Try_Baud_Rate( Host_Baud_Rates[IBaud] );

                                   (* If we didn't get the speed,  *)
                                   (* flush the buffer before next *)
                                   (* try.                         *)

         IF ( NOT Found_Speed ) THEN
            BEGIN
               DELAY( 5 );
               Async_Purge_Buffer;
            END;

      END  (* WHILE *);
                                   (* Flush the buffer once more *)
   DELAY( Tenth_Of_A_Second_Delay );

   Async_Purge_Buffer;

   WRITELN('Communications adjusted to ',Baud_Rate,' baud and parity = ',
           Parity );

END    (* Host_Baud_Detect *);

(*----------------------------------------------------------------------*)
(*     Host_AutoBaud_Detect --- Detect caller's baud rate from modem    *)
(*----------------------------------------------------------------------*)

PROCEDURE Host_AutoBaud_Detect;

VAR
   New_Baud:  INTEGER;

BEGIN (* Host_AutoBaud_Detect *)

   New_Baud := 0;
   J        := POS( Modem_Connect, Modem_Ans ) + LENGTH( Modem_Connect );

   FOR I := J TO LENGTH( Modem_Ans ) DO
      IF Modem_Ans[I] IN ['0'..'9'] THEN
         New_Baud := New_Baud * 10 + ORD( Modem_Ans[I] ) - ORD('0');

   IF New_Baud = 0 THEN New_Baud := 300;

   IF New_Baud > 0 THEN
      BEGIN

         Baud_Rate := New_Baud;

         Async_Reset_Port( Comm_Port, Baud_Rate, Parity, Data_Bits, Stop_Bits );

         WRITELN('Communications adjusted to ',Baud_Rate,' baud.');

      END;

END   (* Host_AutoBaud_Detect *);

(*----------------------------------------------------------------------*)

BEGIN (* Wait_For_Ring *)
                                   (* Nothing from modem yet *)
   Modem_Ans  := '';
                                   (* Assume remote session  *)
   Local_Host := FALSE;
                                   (* Raise terminal ready   *)
   Async_Term_Ready( TRUE );
                                   (* Not done yet           *)
   Done := FALSE;
                                   (* Display intro blurb    *)

   WRITELN('Waiting for phone to ring.');
   WRITELN('Hit ESC key to return to terminal mode.');
   WRITELN('F1 starts/stops chat mode.');
   WRITELN('F2 immediately logs out remote user.');
   WRITELN('Hit any other key to start local host session.');

                                   (* Remove any pending input     *)
   Async_Purge_Buffer;

   REPEAT                          (* Wait for ring/carrier detect *)

      IF KeyPressed THEN
         BEGIN
            READ( Kbd, Ch );
            IF Ch = CHR( ESC ) THEN
               BEGIN
                  IF KeyPressed THEN
                     Local_Host := TRUE
                  ELSE
                     Done := TRUE;
               END
            ELSE
               Local_Host := TRUE;
         END;

   UNTIL ( Host_Carrier_Detect ) OR Done OR Local_Host;

   IF Done THEN Really_Done := TRUE;

                                   (* If local host session,   *)
                                   (* turn off terminal ready  *)
                                   (* so phone isn't answered. *)
   IF Local_Host THEN
      BEGIN
         WRITELN('Local host session begins ... ');
         Async_Term_Ready( FALSE );
         EXIT;
      END;

   IF NOT Done THEN
      BEGIN                        (* Answer the phone *)

         WRITELN('Answered phone ... ');
(*---------------------------------------------------------------*)
(*                                                               *)
(*       ----- Let the modem answer the phone -----              *)
(*                                                               *)
(*       Send_Modem_Command( Modem_Answer );                     *)
(*                                                               *)
(*---------------------------------------------------------------*)

         DELAY( One_Second_Delay );

                                   (* Collect modem response for *)
                                   (* later analysis.            *)
         MTimeOut := FALSE;

         REPEAT

            Async_Receive_With_TimeOut( 1 , Int_Ch );

            IF Int_Ch <> TimeOut THEN
               BEGIN
                  Ch := CHR( Int_Ch );
                  IF Ch IN ['A'..'Z',' ','0'..'9'] THEN
                     Modem_Ans := Modem_Ans + Ch;
                  WRITE( Ch );
                  IF Printer_On THEN
                     WRITE( Lst , Ch );
                  IF Capture_On THEN
                     WRITE( Capture_File , Ch );
               END
            ELSE
               MTimeOut := TRUE;

         UNTIL ( MTimeOut OR Done );

                                   (* Find speed for caller's modem. *)
         IF ( NOT Done ) THEN
            IF Host_Auto_Baud THEN
               Host_AutoBaud_Detect
            ELSE
               Host_Baud_Detect;

      END  (* NOT Done *);

   Done := Done OR ( NOT Host_Carrier_Detect );

END   (* Wait_For_Ring *);

(*----------------------------------------------------------------------*)
(*            Emulate_Host_Mode --- main routine for host mode          *)
(*----------------------------------------------------------------------*)

BEGIN (* Emulate_Host_Mode *)

   Host_Mode   := TRUE;
   Done        := FALSE;
   Really_Done := FALSE;
   First_Time  := TRUE;
                                   (* Initialize host mode *)
   Initialize_Host_Mode;

   IF ( NOT Really_Done ) THEN
      REPEAT
                                   (* Wait for call *)
         Wait_For_Ring( Done );
                                   (* Do a host session *)
         IF NOT Done THEN Do_Host;
                                   (* End host session *)
         Terminate_Host_Mode;

      UNTIL Really_Done;

   WRITELN(' ');
   WRITELN('Host mode communications closed down, ');
   WRITELN('returning to terminal emulation mode. ');

                                   (* Restore previous terminal type *)

   Terminal_To_Emulate := Saved_Gossip_Term;
   Host_Mode           := FALSE;

END   (* Emulate_Host_Mode *);